home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / DDJMAG / DDJ8801.ZIP / SHAMLST.ZIP / SHAMLST.JAN
Text File  |  1980-01-01  |  5KB  |  247 lines
  1.  
  2. Listing One.  Example for declaring various objects that are variations of stack structures
  3.  
  4. PROGRAM Test_Objects(input,output);
  5.  
  6. { Simple example for objects using TML Pascal running on a Mac Plus }
  7.  
  8. TYPE RealStackReg = ARRAY [1..4] OF real;
  9.      IntStackReg  = ARRAY [1..4] OF integer;
  10.  
  11.      { define common stack-related variables and routines }
  12.      TStack = OBJECT
  13.         height : integer;
  14.     ErrorFlag : boolean;
  15.         PROCEDURE TStack.IStack;
  16.     PROCEDURE TStack.Inc(VAR i : integer);
  17.     PROCEDURE TStack.Dec(VAR i : integer);
  18.      END;
  19.      
  20.      { define a 4-register real-typed stack }
  21.      TRealStack = OBJECT(TStack)
  22.         Regs : RealStackReg;
  23.     PROCEDURE Push(Item : real);
  24.     FUNCTION Pop : real;
  25.       PROCEDURE Add;
  26.      END;
  27.      
  28.      { define a 4-register real-typed stack with automatic LastX register }
  29.      THPStack = OBJECT(TRealStack)
  30.         LastX : real;
  31.     PROCEDURE Add; OVERRIDE;
  32.      END;
  33.      
  34.      { define a 4-register integer-typed stack }
  35.      TIntStack = OBJECT(TStack) 
  36.         Regs : IntStackReg;
  37.     PROCEDURE Push(Item : integer);
  38.     FUNCTION Pop : integer;
  39.     PROCEDURE Add;
  40.      END;
  41.      
  42.  
  43. PROCEDURE TStack.IStack;
  44. { Initialize TStack objects by setting the Stack height to zero }
  45. BEGIN
  46.   height := 0
  47. END; { Stack.IStack }
  48.  
  49. PROCEDURE TStack.Inc(VAR i : integer);
  50.  
  51. BEGIN
  52.   i := i + 1;
  53. END;
  54.  
  55. PROCEDURE TStack.Dec(VAR i : integer);
  56.  
  57. BEGIN
  58.   i := i - 1;
  59. END;
  60.  
  61.  
  62. PROCEDURE TRealStack.Push(Item : real);
  63.  
  64. VAR i : integer;
  65.  
  66. BEGIN
  67.    Inc(height);
  68.    FOR i := 4 DOWNTO 2 DO
  69.       Regs[i] := Regs[i-1];
  70.      
  71.    Regs[1] := Item;
  72. END; { RealStack.Push }
  73.  
  74.  
  75. FUNCTION TRealStack.Pop : real;
  76.  
  77. VAR i : integer;
  78.  
  79. BEGIN
  80.    IF height > 0 THEN BEGIN
  81.       Pop := Regs[1];
  82.       FOR i := 1 TO 3 DO
  83.          Regs[i] := Regs[i+1];
  84.       Dec(height);
  85.       ErrorFlag := FALSE;
  86.    END
  87.    ELSE BEGIN
  88.       Pop := 1.0E+30;
  89.       ErrorFlag := TRUE
  90.    END;
  91.   
  92. END; { TRealStack.Pop }
  93.      
  94.  
  95. PROCEDURE TRealStack.Add;
  96.  
  97. VAR i : integer;
  98.  
  99. BEGIN
  100.   Regs[1] := Regs[1] + Regs[2];
  101.   FOR i := 2 TO 3 DO
  102.     Regs[i] := Regs[i+1];
  103. END; { TRealStack.Add }
  104.  
  105. PROCEDURE THPStack.Add; 
  106.  
  107. VAR i : integer;
  108.  
  109. BEGIN
  110.   LastX := Regs[1];
  111.   Regs[1] := Regs[1] + Regs[2];
  112.   FOR i := 2 TO 3 DO
  113.     Regs[i] := Regs[i+1];
  114. END;{ THPStack.Add }
  115.  
  116. PROCEDURE TIntStack.Push(Item : integer);
  117.  
  118. VAR i : integer;
  119.  
  120. BEGIN
  121.    Inc(height);
  122.    FOR i := 4 DOWNTO 2 DO
  123.       Regs[i] := Regs[i-1];
  124.      
  125.    Regs[1] := Item;
  126. END; { TIntStack.Push }
  127.  
  128.  
  129. FUNCTION TIntStack.Pop : integer;
  130.  
  131. VAR i : integer;
  132.  
  133. BEGIN
  134.    IF height > 0 THEN BEGIN
  135.       Pop := Regs[1];
  136.       FOR i := 1 TO 3 DO
  137.          Regs[i] := Regs[i+1];
  138.       Dec(height);
  139.       ErrorFlag := FALSE
  140.    END
  141.    ELSE BEGIN
  142.      Pop := -32767; 
  143.      ErrorFlag := TRUE
  144.    END;
  145. END; { TIntStack.Pop }
  146.  
  147.  
  148. PROCEDURE TIntStack.Add;
  149.  
  150. VAR i : integer;
  151.  
  152. BEGIN
  153.   Regs[1] := Regs[1] + Regs[2];
  154.   FOR i := 2 TO 3 DO
  155.     Regs[i] := Regs[i+1];
  156. END; { TIntStack.Add }
  157.  
  158. { ---------------- declarations of variables ------------------- }
  159.  
  160. VAR RealStack : TRealStack;
  161.     IntStack : TIntStack;
  162.     { HPStack : THPStack; }
  163.     X : real;
  164.     I : integer;
  165.     ch : char;
  166.  
  167. BEGIN
  168.   NEW(RealStack);
  169.   NEW(IntStack);
  170.   NEW(HPStack); 
  171.   { exercise real-type stack }
  172.   RealStack.IStack;
  173.   RealStack.Push(1.0);
  174.   RealStack.Push(2.0);
  175.   RealStack.Push(3.0);
  176.   RealStack.Push(4.0);
  177.   RealStack.Add;
  178.   X := RealStack.Pop;
  179.   WRITELN('X = ',X); WRITELN;
  180.   { use HPStack } 
  181.   HPStack.IStack;
  182.   HPStack.Push(0.0);
  183.   HPStack.Push(0.0);
  184.   HPStack.Push(3.0);
  185.   HPStack.Push(4.0);
  186.   INHERITED HPStack.Add;
  187.   X := HPStack.Pop;
  188.   WRITELN('X = ',X);
  189.   WRITELN('LastX = ',HPStack.LastX); 
  190.   WRITELN;
  191.   { exercise integer-type stack }
  192.   IntStack.IStack;
  193.   IntStack.Push(1);
  194.   IntStack.Push(2);
  195.   IntStack.Push(3);
  196.   IntStack.Push(4);
  197.   IntStack.Add;
  198.   I := IntStack.Pop;
  199.   WRITELN('I = ',I); WRITELN;
  200.   readln(ch);
  201. END.
  202.  
  203.  
  204.  
  205. CONST MAX_MENU = 20; 
  206.  
  207. TYPE STRING80 = STRING[80];
  208.      String_Array = ARRAY [0..MAX+MENU] OF STRING80;
  209.      Menu_Range = 0..MAX_MENU;
  210.  
  211. TMenu = OBJECT
  212.      { declare instance variables }
  213.      Menu_Options : String_Array;
  214.      Num_Options,
  215.      Menu_Choice : Menu_Range;
  216. END;   
  217.  
  218. TItem_Menu = OBJECT(TMenu)
  219.     PROCEDURE Display_Menu;
  220.     FUNCTION Get_Choice : Menu_Range;
  221. END;
  222.  
  223. TControl_Item_Menu = OBJECT(TMenu);
  224.     Current_Level : Menu_Range;
  225.     PROCEDURE Display_Menu;
  226.     FUNCTION Get_Choice : Menu_Range;
  227. END;
  228.  
  229. TMain_Pull_Down = OBJECT(TMenu)
  230.     PROCEDURE Display_Menu;
  231.     FUNCTION Get_Choice : Menu_Range;
  232. END;
  233.  
  234. TPull_Down = OBJECT(TMenu)
  235.     Hot_Key_Char : ARRAY [0.MAX_MENU] OF CHAR;
  236.     Location : ARRAY [0.MAX_MENU] OF INTEGER;
  237.     Attribute : ARRAY [0.MAX_MENU] OF BYTE;
  238.     Active : ARRAY [0.MAX_MENU] OF BOOLEAN;
  239.     PROCEDURE Display_Menu;
  240.     FUNCTION Get_Choice : Menu_Range;
  241. END;
  242.  
  243.  
  244.  
  245. Example 1: Declaration of object types for various kinds of menus
  246.  
  247.